!> \mainpage Functions
!!
!! Functions is an external program to exemplifies the application of DEPP
!!
!! \authors
!!
!!          Jonas Joacir Radtke
!!
!!                 E-mail: jonas.radtke@gmail.com
!!             Curriculum: http://lattes.cnpq.br/7202527344656915
!!                    URL: http://paginapessoal.utfpr.edu.br/jonas
!!
!!
!!          Guilherme Bertoldo
!!
!!                 E-mail: glbertoldo@gmail.com
!!             Curriculum: http://buscatextual.cnpq.br/buscatextual/visualizacv.do?id=H769069
!!
!!
!! \par Institution
!!          Federal University of Technology - Paraná - UTFPR
!!
!!
!! \date March, 2013.
!!
!! \version 1.0
!!
!! \par SVN CHECKOUT
!!          http://depp.googlecode.com/svn/trunk/
!!
program functions

   use depp_interface

   implicit none
   integer :: i      !< dummy index
   integer :: nf     !< function number
   integer :: ind    !< number of the individual
   integer :: nu     !< number of unknowns
   integer :: estatus!< Exit status (0 = success, 1 = failure, 2 = generate another individual)
   real(8) :: fit    !< fitness
   character(200) :: sname !< simulation name
   integer,       dimension(:), allocatable :: xopt   !< Optimization checker
   character(10), dimension(:), allocatable :: xname  !< Name of parameters
   real(8),       dimension(:), allocatable :: x      !< parameters

   open(10, file = "./input_files/input_function.txt")
   read(10,*) nf
   read(10,*) nu
   
   allocate( xopt(nu), xname(nu), x(nu) )

   do i = 1, nu

       read(10,*) xname(i)  ! Parameter name
       read(10,*) xopt(i)   ! Will this parameter be optimized? ( 0 = no, 1 = yes )
       read(10,*) x(i)      ! Parameter value

   end do

   close(10)
 
   ! Reads the parameters from DEPP
   call depp_get_parameters(nu, xopt, xname, x, ind, sname)

   estatus = 0
 
   select case (nf)
      case(1)
         fit = function1(nu, x)
      case(2)
         fit = function2(nu, x)
      case(3)
         fit = function3(nu, x)
      case(4)
         fit = function4(nu, x)
      case(5)
         fit = function5(nu, x)
      case(6)
         fit = function6(nu, x)
      case(7)
         fit = function7(nu, x, estatus)
      case(8)
         fit = bump(nu, x)
      case(9)
         fit = rastrigin(nu, x)
      case(10)
         fit = ackley(nu, x)
      case(11)
         fit = ellipsoid(nu, x)
      case(12)
         fit = rosenbrock(nu, x)
      case default
         write(*,*) " ERROR: invalid function number. "
         stop
   end select


   ! Saves the fitness function to a file
   call depp_save_fitness(fit, estatus, "Fitness")

   
contains

   !============================================================================

   !> \brief Test function 1 (Coley, page 38, 1999)
   real(8) function function1(nu, x)
      implicit none
      integer, intent(in) :: nu     !< number of unknowns
      real(8), intent(in) :: x(nu)  !< parameters (-5.12 < x(i) < 5.12)
      
      integer :: i
      
      function1 = 79.d0
      do i = 1, nu
         function1 = function1 - x(i)**2
      end do
      
   end function function1

   !============================================================================

   !> \brief Test function 2 (Coley, page 38, 1999)
   real(8) function function2(nu, x)
      implicit none
      integer, intent(in) :: nu     !< number of unknowns
      real(8), intent(in) :: x(nu)  !< parameters (-2.048 < x(i) < 2.048)

      integer :: i
      
      function2 = 4000.d0
      do i = 1, nu-1
         function2 = function2 - 100.d0*(x(i)**2 - x(i+1))**2 + (1.d0 - x(i))**2
      end do
   
   end function function2

   !============================================================================

   !> \brief Test function 3 (Coley, page 38, 1999)
   real(8) function function3(nu, x)
      implicit none
      integer, intent(in) :: nu     !< number of unknowns
      real(8), intent(in) :: x(nu)  !< parameters (-5.12 < x(i) < 5.12)
      
      integer :: i
       
      function3 = 26.d0
      do i = 1, nu
         function3 = function3 - dble(int(x(i)))
      end do
   
   end function function3

   !============================================================================

   !> \brief Test function 4 (Coley, page 38, 1999)
   real(8) function function4(nu, x)
      implicit none
      integer, intent(in) :: nu     !< number of unknowns
      real(8), intent(in) :: x(nu)  !< parameters (-100 < x(i) < 100)

      if (nu == 2) then
         function4 = 0.5d0 - ((dsin(dsqrt(x(1)**2 + x(2)**2)))**2 &
            - 0.5d0)/(1.d0 + 0.001d0*(x(1)**2 + x(2)**2))**2
      else
         write(*,*) " ERROR: invalid number of unknowns for function 4. "
         stop
      end if
   
   end function function4

   !============================================================================

   !> \brief Test function 5 (Coley, page 38, 1999)
   real(8) function function5(nu, x)
      implicit none
      integer, intent(in) :: nu     !< number of unknowns
      real(8), intent(in) :: x(nu)  !< parameters (-40 < x(i) < 60)

      integer :: i
      real(8) :: a
      
      a = 5.d0
      
      function5 = a
      
      do i = 1, nu
         function5 = function5 - int(x(i) + 0.5d0)**2
      end do
   
   end function function5

   !============================================================================

   !> \brief Test function 6 (Coley, page 38, 1999)
   real(8) function function6(nu, x)
      implicit none
      integer, intent(in) :: nu     !< number of unknowns
      real(8), intent(in) :: x(nu)  !< parameters (-20 < x(i) < 30)
      
      integer :: i
      real(8) :: a
      real(8) :: sum1
      real(8) :: sum2
      real(8), parameter :: pi = dcos(-1.d0)
      
      a = 5.d0
      
      sum1 = 0.d0
      sum2 = 0.d0
      
      do i = 1, nu
         sum1 = sum1 + x(i)**2
         sum2 = sum2 + dcos(2*pi*x(i))
      end do
      
      function6 = a - 20.d0*dexp(-0.2d0*dsqrt(1.d0/dble(nu)*sum1)) &
         - dexp(1.d0/dble(nu)*sum2) + 20.d0
   
   end function function6

   !============================================================================

   !> \brief Test function 7 (this function is used to test the exit status functionality
   !! of the DEPP program)
   real(8) function function7(nu, x, estatus)
      implicit none
      integer, intent(in)  :: nu      !< number of unknowns
      real(8), intent(in)  :: x(nu)   !< parameters (-1.5 < x(i) < 1.5)
      integer, intent(out) :: estatus !< exit status (0 = success, 1 = failure, 2 = generate another individual)

      ! Inner variables

      integer :: i
      
      function7 = 0.d0

      do i = 1, nu

         function7 = function7 - x(i) * x(i)

      end do

      ! Checking status
      if ( function7 >= -1.d0 ) then ! Success

         estatus = 0

      else if ( -1.d0 > function7 .and. function7 > -2.d0 ) then ! Generate another individual

         estatus = 2

      else ! Failure

         estatus = 1

      end if
   
   end function function7

   !============================================================================

   !> \brief Bump problem (Feoktistov, page 139, 2006)
   real(8) function bump(nu, x)
      implicit none
      integer, intent(in) :: nu     !< number of unknowns
      real(8), intent(in) :: x(nu)  !< parameters (0 < x(i) < 10)

      integer :: i
      real(8) :: sum1
      real(8) :: sum2
      real(8) :: mult
      
      sum1 = 0.d0
      mult = 2.d0
      sum2 = 0.d0
      
      do i = 1, nu
         sum1 = sum1 + dcos(x(i))**4
         mult = mult*dcos(x(i))**2
         sum2 = sum2 + dble(i)*x(i)**2
      end do
      
      bump = dabs(sum1 - mult)/dsqrt(sum2)
   
   end function bump

   !============================================================================

   !> \brief Rastrigin's function (Feoktistov, page 163, 2006)
   real(8) function rastrigin(nu, x)
      implicit none
      integer, intent(in) :: nu     !< number of unknowns
      real(8), intent(in) :: x(nu)  !< parameters (-5.12 < x(i) < 5.12)
      
      integer :: i
      real(8), parameter :: pi = dcos(-1.d0)
       
      rastrigin = 0.d0
      do i = 1, nu
         rastrigin = rastrigin + x(i)**2 - 10.d0*dcos(2.d0*pi*x(i)) + 10.d0
      end do

      rastrigin = - rastrigin
   
   end function rastrigin

   !============================================================================

   !> \brief Ackley's function (Feoktistov, page 163, 2006)
   real(8) function ackley(nu, x)
      implicit none
      integer, intent(in) :: nu     !< number of unknowns
      real(8), intent(in) :: x(nu)  !< parameters (-5.12 < x(i) < 5.12)
      
      integer :: i
      real(8) :: sum1
      real(8) :: sum2
      real(8), parameter :: pi = dcos(-1.d0)
      
      sum1 = 0.d0
      sum2 = 0.d0
      
      do i = 1, nu
         sum1 = sum1 + x(i)**2
         sum2 = sum2 + dcos(2.d0*pi*x(i))
      end do
   
      ackley = -20.d0*dexp(-0.2d0*dsqrt(1.d0/dble(nu)*sum1)) &
         - dexp(1.d0/dble(nu)*sum2) + 20.d0 + dexp(1.d0)

      ackley = - ackley
   
   end function ackley

   !============================================================================

   !> \brief Rotated Ellipsoid function (Feoktistov, page 164, 2006)
   real(8) function ellipsoid(nu, x)
      implicit none
      integer, intent(in) :: nu     !< number of unknowns
      real(8), intent(in) :: x(nu)  !< parameters (-65.536 < x(i) < 65.536)
      
      integer :: i
      integer :: j
      real(8) :: sum1
      
      ellipsoid = 0.d0
      do i = 1, nu
      
         sum1 = 0.d0
         
         do j = 1, i
            sum1 = sum1 + x(j)
         end do
         
         ellipsoid = ellipsoid - sum1**2
         
      end do
   
   end function ellipsoid

   !============================================================================
   
   !> \brief Rosenbrock (Feoktistov, 2006) page 160
   real(8) function rosenbrock(nu, x)
      implicit none
      integer, intent(in) :: nu     !< number of unknowns
      real(8), intent(in) :: x(nu)  !< parameters (-2.048 < x(i) < 2.048)

      integer :: i
      
      rosenbrock = 0.d0
      
      do i = 1, nu-1
      
         rosenbrock = rosenbrock + 100.d0*(x(i)**2 - x(i+1))**2 + (1.d0 - x(i))**2
      
      end do
      
      rosenbrock = -rosenbrock
   
   end function rosenbrock


end program functions

